home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-13 / me_cd22.zip / MUTT2.ZIP / CALC.MUT < prev    next >
Text File  |  1992-04-27  |  3KB  |  128 lines
  1.   ;; calc.mut : a popup programmers calculator for ME
  2.   ;; C Durland    Public Domain
  3.  
  4. (include me2.h)
  5. (include tobase.mut)
  6.  
  7. (int RV TV mem)
  8. (small-int base)
  9.  
  10. (defun
  11.   doc HIDDEN    ; popup a window with documentation
  12.   {
  13.     (menu-box
  14.     ">Mutt CALC - an RPN calculator"
  15.     "+ - * (or x) /"
  16.     "Enter or Return : move x to total"
  17.     "m : Negate x"
  18.     "| & \^ : bitwise OR, AND, XOR total and x"
  19.     "< > : shift left or right"
  20.     "% : total mod x"
  21.     "s : Store total in memory"
  22.     "r : Recall memory to x"
  23.     "= : Insert total at dot"
  24.     "\^H or BACKSPACE : Erase last digit of x"
  25.     "\^L : Redraw the screen"
  26.     "# : Toggle between decimal and hex"
  27.     "B : Change the radix"
  28.     "k : Put the next key pressed into total"
  29.     'q ^G : Quit')
  30.     (refresh-screen)
  31.   }
  32.   MAIN
  33.   {
  34.     (base 10)                ;; initialize base to decimal
  35.     (require "popup.mut")        ;; for (doc)
  36.   }
  37.   inc (int n) HIDDEN        ; increment TV by n
  38.   {
  39.     (if (< n base) (TV (+ (* TV base) n)) )
  40.   }
  41.   vert (int n)    HIDDEN    ; convert n to proper base for display
  42.   {
  43.     (if (== base 10) { n (done) } )
  44.     (if (< n 0) (concat "-" (tobase (- 0 n) base)) (tobase n base))
  45.   }
  46. ;  odd (int n) HIDDEN { (!= n (* (/ n 2) 2)) }    ; TRUE if n is odd
  47. ;  bitwise (pointer defun op)(int x y) HIDDEN    ; (bitwise-op x y)
  48. ;  {
  49. ;    (int bit result a b)
  50. ;
  51. ;    (result 0)(bit 1)(a x)(b y)
  52. ;    (while (or (!= 0 a)(!= 0 b))
  53. ;    {
  54. ;      (if (op a b) (+= result bit))
  55. ;      (*= bit 2)    ; next bit
  56. ;      (/= a 2)(/= b 2)
  57. ;    })
  58. ;    result
  59. ;  }
  60. ;  bor  (int a b) HIDDEN { (or (odd a)(odd b)) }  ;TRUE if ((a&1) OR (b&1))==1
  61. ;  band (int a b) HIDDEN { (and (odd a)(odd b)) } ;TRUE if ((a&1) AND (b&1))==1
  62. ;  bxor (int a b) HIDDEN { (odd (+ a b)) }     ;TRUE if ((a&1) XOR (b&1))==1
  63. ;  bit-or  (int x y) HIDDEN { (bitwise (floc bor)  x y) }
  64. ;  bit-and (int x y) HIDDEN { (bitwise (floc band) x y) }
  65. ;  bit-xor (int x y) HIDDEN { (bitwise (floc bxor) x y) }
  66.   calculator
  67.   {
  68.     (int n)
  69.  
  70.     (while TRUE
  71.     {
  72.       (msg "RPN CALC>" base " Memory: " (vert mem base)
  73.     " Total: " (vert RV) "  x: " (vert TV) )
  74.       (switch (getchar)
  75.     "0" (inc 0)
  76.     "1" (inc 1)
  77.     "2" (inc 2)
  78.     "3" (inc 3)
  79.     "4" (inc 4)
  80.     "5" (inc 5)
  81.     "6" (inc 6)
  82.     "7" (inc 7)
  83.     "8" (inc 8)
  84.     "9" (inc 9)
  85.         "+" { (+= RV TV)(TV 0) }
  86.         "-" { (-= RV TV)(TV 0) }
  87.         "*" { (*= RV TV)(TV 0) }
  88.         "x" { (*= RV TV)(TV 0) }
  89.         "/" { (if (== 0 TV)(RV 0)(/= RV TV)) (TV 0) } 
  90.     "a" (inc 10)
  91.     "b" (inc 11)
  92.     "c" (inc 12)
  93.     "d" (inc 13)
  94.     "e" (inc 14)
  95.     "f" (inc 15)
  96.     "=" { (insert-text (vert RV))(update) }
  97.     "^M" { (RV TV)(TV 0) }            ; enter
  98.     "m" (*= TV -1)                ; change sign
  99.     "|" { (RV (bit-or RV TV)) (TV 0) }
  100.     "&" { (RV (bit-and RV TV)) (TV 0) }
  101.     '^' { (RV (bit-xor RV TV)) (TV 0) }
  102.     '%' { (if (== 0 TV)(RV 0)(RV (mod RV TV))) (TV 0) }
  103.     "^H" (/= TV base)
  104.     "s" (mem RV)                ; store
  105.     "r" (TV mem)                ; recall
  106.     "^L" { (refresh-screen)(update) }    ; refresh screen
  107.     ">" (/= RV 2)                ; shift right
  108.     "<" (*= RV 2)                ; shift left
  109.     "#" (if (== base 10)(base 16)(base 10))    ; toggle radix
  110.     "B"                    ; change radix
  111.       {
  112.         (n (convert-to NUMBER (ask "base = ")))
  113.         (if (and (<= 2 n)(<= n 16)) (base n))
  114.       }
  115.     "k"
  116.       {
  117.         (msg "Press key to convert")
  118.         (RV (convert-to CHARACTER (getchar)))
  119.       }
  120.     "K" { (msg "Press ME key to convert")(RV (get-key)) }
  121.     "?" (doc)
  122.     "q" (break)            ; quit
  123.     "^G" (break)            ; quit
  124.       )
  125.     })
  126.   }
  127. )
  128.